home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / front.lha / front / src / Path.mi < prev    next >
Text File  |  1992-08-18  |  1KB  |  61 lines
  1. (* add path to file name *)
  2.  
  3. (* $Id: Path.mi,v 1.3 1992/01/30 13:34:33 grosch rel $ *)
  4.  
  5. (* $Log: Path.mi,v $
  6.  * Revision 1.3  1992/01/30  13:34:33  grosch
  7.  * redesign of interface to operating system
  8.  *
  9.  * Revision 1.2  1991/11/21  14:47:50  grosch
  10.  * new version of RCS on SPARC
  11.  *
  12.  * Revision 1.1  90/06/11  18:45:22  grosch
  13.  * layout improvements
  14.  * 
  15.  * Revision 1.0     88/10/04  14:27:06  vielsack
  16.  * Initial revision
  17.  * 
  18.  *)
  19.  
  20. IMPLEMENTATION MODULE Path;
  21.  
  22. FROM    Strings        IMPORT    tString,    tStringIndex,    SubString,
  23.                 Char,        Append,        Length,
  24.                 Concatenate,    ArrayToString,    StringToArray;
  25.  
  26. FROM    System        IMPORT    GetArgument;
  27.  
  28.  
  29. PROCEDURE InsertPath (VAR a: ARRAY OF CHAR);
  30.   VAR
  31.     s1,s2 : tString;
  32.     l : tString;
  33.     Arg : ARRAY [0..255] OF CHAR;
  34.     pos : tStringIndex;
  35.   BEGIN
  36.     
  37.     (* get program name *)
  38.  
  39.     GetArgument (0, Arg);
  40.     ArrayToString (Arg, s1);
  41.  
  42.     (* find last '/' in program name *)
  43.  
  44.     pos := Length (s1);
  45.     WHILE (pos > 0) & ((Char (s1, pos) # '/')) DO
  46.       DEC (pos)
  47.     END;
  48.  
  49.     (* if the path is not empty insert it *)
  50.  
  51.     IF pos > 0 THEN
  52.       SubString (s1, 1, pos, s2);
  53.       ArrayToString (a, s1);
  54.       Concatenate (s2, s1);
  55.       Append (s2, 0C);
  56.       StringToArray (s2, a);
  57.     END;
  58.   END InsertPath;
  59.  
  60. END Path.
  61.